library(GeoPressureR)
library(leaflet)
library(leaflet.extras)
library(raster)
library(dplyr)
library(ggplot2)
library(plotly)
knitr::opts_chunk$set(echo = params$printcode)
load(paste0("../data/6_basic_graph/", params$gdl_id, "_basic_graph.Rdata"))
load(paste0("../data/5_static_prob/", params$gdl_id, "_static_prob.Rdata"))

Pressure timeserie

pressure_na <- pam$pressure %>%
  mutate(obs = ifelse(isoutliar | sta_id == 0, NA, obs))
p <- ggplot() +
  geom_line(data = pam$pressure, aes(x = date, y = obs), colour = "grey") +
  # geom_point(data = subset(pam$pressure, isoutliar), aes(x = date, y = obs), colour = "black") +
  geom_line(data = pressure_na, aes(x = date, y = obs, color = factor(sta_id)), size = 0.5) +
  geom_line(data = do.call("rbind", shortest_path_timeserie), aes(x = date, y = pressure0, col = factor(sta_id)), linetype = 2) +
  theme_bw() +
  scale_colour_manual(values = col) +
  scale_y_continuous(name = "Pressure(hPa)")

ggplotly(p, dynamicTicks = T) %>% layout(showlegend = F)

Alitude

p <- ggplot() +
  # geom_line(data = pam$pressure, aes(x = date, y = obs), colour = "grey") +
  geom_line(data = do.call("rbind", shortest_path_timeserie), aes(x = date, y = altitude, col = factor(sta_id))) +
  theme_bw() +
  scale_colour_manual(values = col) +
  scale_y_continuous(name = "Altitude (m)")

ggplotly(p, dynamicTicks = T) %>% layout(showlegend = F)

Shortest path and simulated path

sta_duration <- unlist(lapply(static_prob_marginal, function(x) {
  as.numeric(difftime(metadata(x)$temporal_extent[2], metadata(x)$temporal_extent[1], units = "days"))
}))
pal <- colorFactor(col, as.factor(seq_len(length(col))))
m <- leaflet(width = "100%") %>%
  addProviderTiles(providers$Stamen.TerrainBackground) %>%
  addFullscreenControl() %>%
  addPolylines(lng = grl$shortest_path$lon, lat = grl$shortest_path$lat, opacity = 1, color = "#808080", weight = 3) %>%
  addCircles(lng = grl$shortest_path$lon, lat = grl$shortest_path$lat, opacity = 1, color = pal(factor(grl$shortest_path$sta_id, levels = pam$sta$sta_id)), weight = sta_duration^(0.3) * 10)

for (i in seq_len(nrow(path_sim$lon))) {
  m <- m %>%
    addPolylines(lng = path_sim$lon[i, ], lat = path_sim$lat[i, ], opacity = 0.5, weight = 1, color = "#808080") %>%
    addCircles(lng = path_sim$lon[i, ], lat = path_sim$lat[i, ], opacity = .7, weight = 1, color = pal(factor(grl$shortest_path$sta_id, levels = pam$sta$sta_id)))
}
m

Marginal probability map

li_s <- list()
l <- leaflet(width = "100%") %>%
  addProviderTiles(providers$Stamen.TerrainBackground) %>%
  addFullscreenControl()
for (i_r in seq_len(length(static_prob_marginal))) {
  i_s <- metadata(static_prob_marginal[[i_r]])$sta_id
  info <- metadata(static_prob_marginal[[i_r]])$temporal_extent
  info_str <- paste0(i_s, " | ", info[1], "->", info[2])
  li_s <- append(li_s, info_str)
  l <- l %>%
    addRasterImage(static_prob_marginal[[i_r]], colors = "OrRd", opacity = 0.8, group = info_str) %>%
    addCircles(lng = grl$shortest_path$lon[i_s], lat = grl$shortest_path$lat[i_s], opacity = 1, color = "#000", weight = 10, group = info_str)
}
l %>%
  addLayersControl(
    overlayGroups = li_s,
    options = layersControlOptions(collapsed = FALSE)
  ) %>%
  hideGroup(tail(li_s, length(li_s) - 1))

Appendix

Stationay period information

pam$sta
##                   start                 end sta_id
## 1   2018-07-15 00:00:00 2018-08-26 12:35:00      1
## 2   2018-08-26 19:45:00 2018-08-27 12:40:00      2
## 3   2018-08-27 20:35:00 2018-08-28 13:10:00      3
## 4   2018-08-28 15:45:00 2018-08-29 13:55:00      4
## 5   2018-08-29 14:50:00 2018-08-29 20:30:00      5
## 6   2018-08-29 21:20:00 2018-08-30 12:40:00      6
## 7   2018-08-30 22:25:00 2018-08-31 12:55:00      7
## 8   2018-08-31 21:50:00 2018-09-01 13:45:00      8
## 9   2018-09-01 17:35:00 2018-09-02 14:15:00      9
## 10  2018-09-02 19:40:00 2018-09-04 14:10:00     10
## 11  2018-09-04 23:15:00 2018-09-05 14:20:00     11
## 12  2018-09-05 23:15:00 2018-09-06 15:30:00     12
## 13  2018-09-06 22:25:00 2018-09-07 15:00:00     13
## 14  2018-09-07 23:55:00 2018-09-08 19:40:00     14
## 15  2018-09-09 00:20:00 2018-09-09 15:20:00     15
## 16  2018-09-09 22:50:00 2018-09-10 15:30:00     16
## 17  2018-09-11 00:30:00 2018-09-11 14:10:00     17
## 18  2018-09-12 00:40:00 2018-09-12 19:40:00     18
## 19  2018-09-12 20:45:00 2018-09-13 14:00:00     19
## 20  2018-09-13 14:55:00 2018-09-14 15:00:00     20
## 21  2018-09-14 16:40:00 2018-09-15 13:55:00     21
## 22  2018-09-15 15:05:00 2018-09-17 00:30:00     22
## 23  2018-09-17 00:40:00 2018-09-17 13:55:00     23
## 24  2018-09-17 15:25:00 2018-09-17 16:30:00     24
## 25  2018-09-17 19:35:00 2018-09-17 22:35:00     25
## 26  2018-09-18 00:00:00 2018-09-19 00:35:00     26
## 27  2018-09-19 00:50:00 2018-09-19 13:50:00     27
## 28  2018-09-19 14:05:00 2018-09-21 00:20:00     28
## 29  2018-09-21 00:55:00 2018-10-01 13:35:00     29
## 30  2018-10-01 20:15:00 2018-10-02 14:15:00     30
## 31  2018-10-03 01:05:00 2018-10-03 14:00:00     31
## 32  2018-10-04 01:20:00 2018-10-04 15:20:00     32
## 33  2018-10-04 22:50:00 2018-10-05 14:25:00     33
## 34  2018-10-06 01:40:00 2018-10-06 14:55:00     34
## 35  2018-10-07 01:50:00 2018-10-07 15:10:00     35
## 36  2018-10-08 01:55:00 2018-10-08 15:45:00     36
## 37  2018-10-08 21:55:00 2018-10-09 15:10:00     37
## 38  2018-10-10 00:20:00 2018-10-10 16:10:00     38
## 39  2018-10-10 23:55:00 2018-10-11 14:55:00     39
## 40  2018-10-11 15:05:00 2018-10-12 01:45:00     40
## 41  2018-10-12 02:10:00 2018-10-12 14:55:00     41
## 42  2018-10-12 15:15:00 2018-10-17 21:55:00     42
## 43  2018-10-17 23:40:00 2018-10-26 00:40:00     43
## 44  2018-10-26 02:05:00 2018-10-26 14:50:00     44
## 45  2018-10-26 19:30:00 2018-10-27 14:55:00     45
## 46  2018-10-27 20:05:00 2018-10-28 18:35:00     46
## 47  2018-10-29 02:20:00 2018-10-29 15:10:00     47
## 48  2018-10-29 15:30:00 2018-10-30 18:50:00     48
## 49  2018-10-30 22:40:00 2018-10-31 21:45:00     49
## 50  2018-10-31 22:25:00 2018-11-01 21:05:00     50
## 51  2018-11-01 21:25:00 2018-11-16 15:25:00     51
## 52  2018-11-16 19:20:00 2018-11-19 17:05:00     52
## 53  2018-11-19 18:55:00 2018-11-21 16:00:00     53
## 54  2018-11-21 23:25:00 2018-11-22 15:35:00     54
## 55  2018-11-23 02:45:00 2018-11-23 20:50:00     55
## 56  2018-11-24 02:45:00 2018-11-24 16:45:00     56
## 57  2018-11-25 02:45:00 2018-11-27 17:05:00     57
## 58  2018-11-28 02:45:00 2018-11-28 17:25:00     58
## 59  2018-11-28 22:10:00 2018-11-29 18:25:00     59
## 60  2018-11-29 19:00:00 2018-11-30 16:30:00     60
## 61  2018-12-01 02:10:00 2018-12-01 21:50:00     61
## 62  2018-12-02 02:00:00 2018-12-02 18:35:00     62
## 63  2018-12-03 02:20:00 2018-12-03 18:45:00     63
## 64  2018-12-04 03:10:00 2018-12-04 19:10:00     64
## 65  2018-12-05 02:30:00 2018-12-05 19:55:00     65
## 66  2018-12-05 20:25:00 2019-04-01 16:50:00     66
## 67  2019-04-02 03:30:00 2019-04-02 16:50:00     67
## 68  2019-04-03 00:35:00 2019-04-03 16:45:00     68
## 69  2019-04-04 03:10:00 2019-04-04 17:05:00     69
## 70  2019-04-05 00:20:00 2019-04-05 17:35:00     70
## 71  2019-04-05 23:30:00 2019-04-06 18:55:00     71
## 72  2019-04-07 03:15:00 2019-04-07 17:10:00     72
## 73  2019-04-08 00:15:00 2019-04-08 16:55:00     73
## 74  2019-04-09 02:50:00 2019-04-09 17:10:00     74
## 75  2019-04-09 19:40:00 2019-04-09 23:55:00     75
## 76  2019-04-10 02:55:00 2019-04-10 17:55:00     76
## 77  2019-04-10 18:50:00 2019-04-10 20:50:00     77
## 78  2019-04-10 21:45:00 2019-04-11 00:55:00     78
## 79  2019-04-11 02:40:00 2019-04-11 20:35:00     79
## 80  2019-04-12 02:45:00 2019-04-17 16:35:00     80
## 81  2019-04-18 02:50:00 2019-04-18 16:30:00     81
## 82  2019-04-19 01:30:00 2019-04-19 20:25:00     82
## 83  2019-04-19 22:40:00 2019-04-22 17:05:00     83
## 84  2019-04-23 04:10:00 2019-04-24 00:35:00     84
## 85  2019-04-24 02:55:00 2019-04-29 00:50:00     85
## 86  2019-04-29 01:20:00 2019-04-29 16:35:00     86
## 87  2019-04-29 20:35:00 2019-04-30 00:10:00     87
## 88  2019-04-30 02:25:00 2019-04-30 15:35:00     88
## 89  2019-05-01 02:20:00 2019-05-01 16:05:00     89
## 90  2019-05-02 02:05:00 2019-05-02 15:30:00     90
## 91  2019-05-03 02:00:00 2019-05-03 15:30:00     91
## 92  2019-05-04 02:00:00 2019-05-04 15:20:00     92
## 93  2019-05-05 01:55:00 2019-05-05 15:25:00     93
## 94  2019-05-06 01:45:00 2019-05-06 15:40:00     94
## 95  2019-05-07 01:35:00 2019-05-07 15:10:00     95
## 96  2019-05-08 01:15:00 2019-05-08 15:50:00     96
## 97  2019-05-09 01:00:00 2019-05-09 16:00:00     97
## 98  2019-05-09 23:30:00 2019-05-10 16:00:00     98
## 99  2019-05-11 00:45:00 2019-05-11 15:05:00     99
## 100 2019-05-11 15:10:00 2019-05-12 20:25:00    100
## 101 2019-05-12 20:50:00 2019-05-13 18:25:00    101
## 102 2019-05-13 19:30:00 2019-05-14 20:50:00    102
## 103 2019-05-15 00:35:00 2019-05-15 15:45:00    103
## 104 2019-05-16 00:10:00 2019-05-16 14:55:00    104
## 105 2019-05-16 15:35:00 2019-05-17 15:05:00    105
## 106 2019-05-17 16:10:00 2019-05-18 15:05:00    106
## 107 2019-05-18 15:40:00 2019-05-19 15:10:00    107
## 108 2019-05-19 15:35:00 2019-05-20 16:00:00    108
## 109 2019-05-20 18:05:00 2019-05-21 15:10:00    109
## 110 2019-05-21 15:30:00 2019-05-22 15:45:00    110
## 111 2019-05-23 00:10:00 2019-05-23 15:00:00    111
## 112 2019-05-23 23:50:00 2019-05-24 15:40:00    112
## 113 2019-05-24 23:30:00 2019-05-25 15:10:00    113
## 114 2019-05-25 23:10:00 2019-05-26 15:55:00    114
## 115 2019-05-26 23:00:00 2019-05-27 16:05:00    115
## 116 2019-05-27 22:45:00 2019-05-28 14:55:00    116
## 117 2019-05-28 15:35:00 2019-05-29 16:20:00    117
## 118 2019-05-29 22:40:00 2019-05-30 15:30:00    118
## 119 2019-05-30 22:05:00 2019-05-31 06:10:00    119

Parameter used for the simulation

set
## # A tibble: 1 × 30
##   include gdl_id crop_start          crop_end            thr_dur extent_N
##   <lgl>   <chr>  <dttm>              <dttm>                <dbl>    <dbl>
## 1 TRUE    22BT   1900-01-01 00:00:00 2100-01-01 00:00:00      24       50
## # … with 24 more variables: extent_W <dbl>, extent_S <dbl>, extent_E <dbl>,
## #   map_scale <dbl>, map_max_sample <dbl>, map_margin <dbl>, prob_map_s <dbl>,
## #   prob_map_thr <dbl>, shift_k <dbl>, calib_lon <dbl>, calib_lat <dbl>,
## #   calib_1_start <dttm>, calib_1_end <dttm>, calib_2_start <lgl>,
## #   calib_2_end <lgl>, calib_2_lon <lgl>, calib_2_lat <lgl>,
## #   prob_light_w <dbl>, RingNo <lgl>, scientific_name <lgl>, common_name <chr>,
## #   mass <lgl>, wing_span <lgl>, Color <lgl>